home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 16 / envptibm.zip / SIDEPRNT.PAS < prev   
Pascal/Delphi Source File  |  1987-05-20  |  6KB  |  241 lines
  1. {
  2.  SIDEPRNT ... sideways (rotated) printing ...
  3.  Author --- John T. Bagwell, Jr.
  4.  
  5.  MODIFIED-- John R. DeBolt -- April 1987 to operate on an IBM
  6.             compatible, OKIDATA ML192 printer.
  7.  
  8. Uses Character tables in the BIOS ROM sto do a simple form of
  9. sideways printing. Character values above 127 aren't supported.
  10.  
  11. Formfeed acts as a 'page' eject, even in the middle of a line;
  12. a line ends at CR/LF, FF, or end-of-file.
  13. }
  14.  
  15. program SidePrint;
  16.  
  17. const
  18.   PrintMultipleSpacing = #13#27#51#1#10;
  19.   JiggleDown = #13#27#51#24;
  20.   NormalSpacing = #27#65#12#27#50;
  21.   GraphicsPrint = #27;
  22.   ResetPrinter  = #24;
  23.   LineFeed = #10;
  24.   FormFeed = #12;
  25.   AddX = 25;
  26.                             { possible choices }
  27.   BitsPerChar =      9;   {   9     9 }
  28.   PrintType =      #75;   { #75   #75 }
  29.   N1 =            #225;   {#221  #225 }
  30.   N2 =              #0;   {  #1    #0 }
  31.   MaxLineLen =    1000;   { 480   480 }
  32.   MaxLinesPerPage = 25;   {  53    25 }
  33.  
  34. type
  35.   BitMap = array[0..7] of Char;
  36.   Line = array[1..MaxLineLen] of Char;
  37.  
  38. var
  39.   zero1: byte;
  40.   Paper: array[1..MaxLinesPerPage] of Line;
  41.   zero2: byte;
  42.   LineNo,CharNo,i,j,k,BitsPerPage,LineLen: Integer;
  43.   Cindex,PrintMultiple: Byte;
  44.   RetFile,InFile: Text;
  45.   InChar: Char;
  46.   CharTable: array[0..127] of BitMap absolute $F000:$FA6E;  {BIOS Table}
  47.  
  48. procedure ZERO;
  49.   begin
  50.     FillChar(zero1, ofs(zero2) - ofs(zero1) + sizeof(zero2), 0);
  51.   end;
  52.  
  53. (*---------------------------------*)
  54. (*         READ ONE PAGE           *)
  55. (*---------------------------------*)
  56.  
  57. procedure ReadOnePage;
  58.  
  59. var
  60.   LineSize: array[1..91] of Integer;    {big enough for all options}
  61.   eject: Boolean;
  62.  
  63. begin
  64.   LineNo:=1;
  65.   CharNo:=0;
  66.   LineLen:=0;
  67.   eject:=False;
  68.   Zero;
  69.  
  70.   For i:=1 to MaxLinesPerPage do     {erase old lines}
  71.     LineSize[i]:=0;
  72.  
  73. repeat
  74.         {accumulate a line ...}
  75.   While (not eoln(RetFile)) AND (not eject) do
  76.     begin
  77.       Read(RetFile,InChar);
  78.       If InChar = FormFeed then          {watch for page ejects}
  79.         If (LineNo = 1) AND (CharNo = 0) then
  80.             {Ignore redundant page ejects}
  81.         else
  82.           eject:=True
  83.       else
  84.         If CharNo <= MaxLineLen then       {build a line}
  85.           begin
  86.             CharNo:=CharNo+1;
  87.             Paper[LineNo,CharNo]:=InChar;
  88.           end;
  89.     end;
  90.  
  91.           {at end of each line ...}
  92.  
  93.     If CharNo > LineLen then             {save longest line length}
  94.       LineLen:=CharNo;
  95.     LineSize[LineNo]:=CharNo;
  96.     LineNo:=LineNo+1;
  97.     CharNo:=0;
  98.     If eoln(RetFile) then
  99.       ReadLn(RetFile);                    {get the end-of-line mark}
  100.  
  101.       {force eject when page is full ...}
  102.  
  103.     If LineNo > MaxLinesPerPage then
  104.       eject:=True;
  105.  
  106. until eof(RetFile) OR (eject);
  107.  
  108.   LineNo:=12;
  109.   CharNo:=0;
  110.   LineLen:=0;
  111.   eject:=False;
  112.  
  113. repeat
  114.         {accumulate a line ...}
  115.   While (not eoln(InFile)) AND (not eject) do
  116.     begin
  117.       Read(InFile,InChar);
  118.       If InChar = FormFeed then          {watch for page ejects}
  119.         If (LineNo = 1) AND (CharNo = 0) then
  120.             {Ignore redundant page ejects}
  121.         else
  122.           eject:=True
  123.       else
  124.         If CharNo <= MaxLineLen then       {build a line}
  125.           begin
  126.             CharNo:=CharNo+1;
  127.             Paper[LineNo,CharNo+AddX]:=InChar;
  128.           end;
  129.     end;
  130.  
  131.           {at end of each line ...}
  132.  
  133.     If CharNo+AddX > LineLen then             {save longest line length}
  134.       LineLen:=CharNo+AddX;
  135.     LineSize[LineNo]:=CharNo+AddX;
  136.     LineNo:=LineNo+1;
  137.     CharNo:=0;
  138.     If eoln(InFile) then
  139.       ReadLn(InFile);                    {get the end-of-line mark}
  140.  
  141.       {force eject when page is full ...}
  142.  
  143.     If LineNo > MaxLinesPerPage then
  144.       eject:=True;
  145.  
  146. until eof(InFile) OR (eject);
  147.  
  148. (*  make each line the same length *)
  149.  
  150. For i:=1 to MaxLinesPerPage do
  151.   For j:=LineSize[i]+1 to LineLen do
  152.     Paper[i,j]:=' ';
  153.  
  154. end;   {procedure ReadOnePage}
  155.  
  156. (*--------------------------------*)
  157. (*        PRINT ONE PAGE          *)
  158. (*--------------------------------*)
  159.  
  160. procedure PrintOnePage;
  161.  
  162. begin
  163.   For j:=1 to LineLen do   {each rotated 'line'... actually, each character}
  164.     begin
  165.       For LineNo:=1 to PrintMultiple do
  166.         begin
  167.           If LineNo = 2 then Write(Lst,PrintMultipleSpacing);
  168.           Write(Lst,GraphicsPrint,PrintType,N1,N2);
  169.           For i:=MaxLinesPerPage downto 1 do    {lines in reverse order}
  170.             begin
  171.               Cindex:=Ord(Paper[i,j]);
  172.               If BitsPerChar = 9 then {For loop (9 to ...) req'd if it is >9}
  173.                 Write(Lst,#0);
  174.               For k:=7 downto 0 do
  175.                 Write(Lst,CharTable[Cindex][k]);   {bottom up each char}
  176.             end;
  177.         end;
  178.         Write(Lst,JiggleDown);
  179.         Write(Lst,LineFeed);
  180.     end;
  181. end;    {procedure PrintOnePage}
  182.  
  183.  
  184. (* -------- MAIN PROGRAM -------- *)
  185.  
  186.  
  187. begin
  188.  
  189.     (*  GET FILE PARAMETERS *)
  190.  
  191.   If Paramcount < 1 then
  192.     begin
  193.       WriteLn(^G'Missing file name on command line');
  194.       Halt;
  195.     end;
  196.   Assign(RetFile,'C:RETURN.DAT');
  197.   {$I-}
  198.   Reset(RetFile);
  199.   {$I+}
  200.   If IOResult <> 0 then
  201.     begin
  202.       Writeln('File "RETURN.DAT" not found.');
  203.       Halt;
  204.     end;
  205.   Assign(InFile,Paramstr(1));     {OPEN the file}
  206.   {$I-}
  207.   Reset(InFile);
  208.   {$I+}
  209.   If IOResult <> 0 then
  210.     begin
  211.       WriteLn('File "',Paramstr(1),'" not found.');
  212.       Halt;
  213.     end;
  214.  
  215.     (*  GET /D DOUBLE-PRINT OPTION  *)
  216.  
  217.   PrintMultiple:=1;
  218.   If Paramcount >= 2 then
  219.     If (Paramstr(2) = '/d') OR (paramstr(2) = '/D') then
  220.       PrintMultiple:=2;
  221.  
  222.     (*  SET UP *)
  223.  
  224.   BitsPerPage:=BitsPerChar * MaxLinesPerPage;
  225.   Write(Lst,ResetPrinter);
  226.  
  227.     (*  MAIN LOOP  *)
  228.  
  229.   Repeat       {do one "page" at a time}
  230.     ReadOnePage;
  231.     PrintOnePage;
  232.     Write(Lst,FormFeed);      {do a page eject to line up properly}
  233.   until eof(InFile);
  234.  
  235.     (*  ALL DONE  *)
  236.  
  237.   Close(InFile);
  238.   Write(Lst,ResetPrinter);
  239.   Write(Lst,NormalSpacing);        {resume normal spacing vertically}
  240. end.   {main program}
  241.